perm filename ZZZZ[X,ALS] blob
sn#088673 filedate 1974-02-26 generic text, type T, neo UTF8
00010 BEGIN "XRUN"
00020 DEFINE ⊂="COMMENT";
00030
00040 ⊂ This program runs another program, BXX, as a separate job and produces
00050 an XGP plot of formant data from the specified file. This program may
00060 be executed directly, in which case it requests info from the TTY, or it
00070 be called into being as a separate job and passed a number specifying
00080 the file to be used. In this second case this program automatically
00090 kills its job on completion;
00100
00110 DEFINE ⊃="⊂";
00120 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130 INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN5,CHAN1,EOF,BRCHR,
00140 PP,POINTP,FLAG,MUTE,NUM;
00150 STRING FILEP,FILEN,READ,MEMO; BOOLEAN ER;
00160 INTEGER ARRAY SAVE[0:10];
00170 INTEGER ARRAY LFILE[0:127];
00180 INTEGER ARRAY NEW[0:511];
00190 INTEGER ARRAY DPYBUF[0:4096];
00200 INTEGER A1,A2,A3;
00210 LABEL STARTP;
00220 INTEGER DATE,TIME,SCALE;
00230 DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00240 PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00250 "SEP","OCT","NOV","DEC";
00260 STRING ARRAY MONTHS[0:11];
00270
00280 INTERNAL STRING PROCEDURE DATIM;
00290 BEGIN
00300 INTEGER DAY,YR,HRS,MIN,SEC;
00310 DAY←(DATE MOD 31)+1;DATE←DATE%31;
00320 YR←1964+DATE%12; SEC←TIME MOD 60;
00330 TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00340 SETFORMAT(-2,0);
00350 RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00360 "-"&CVS(YR)&" "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00370 END;
00380
00390 INTERNAL STRING PROCEDURE WTIM;
00400 BEGIN
00410 DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00420 RETURN(DATIM);
00430 END;
00440
00450 INTERNAL STRING PROCEDURE DATIME;
00460 BEGIN
00470 GETIME;
00480 RETURN(DATIM);
00490 END;
00500
00510
00520 ⊂ Allow 1140 units on a line corresponding to 76 charactters @15 units,
00530 380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00540
00550
00560 PROCEDURE XPLOT;
00570 BEGIN "XPLOT"
00580 REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00590 REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00600 REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00610 EXTERNAL FORTRAN PROCEDURE XSET;
00620 EXTERNAL FORTRAN PROCEDURE XRVEC;
00630 EXTERNAL FORTRAN PROCEDURE XVEC;
00640 EXTERNAL FORTRAN PROCEDURE XIVEC;
00650 EXTERNAL FORTRAN PROCEDURE XIRVEC;
00660 EXTERNAL FORTRAN PROCEDURE XLINE;
00670 EXTERNAL FORTRAN PROCEDURE VERTAX;
00680 EXTERNAL FORTRAN PROCEDURE SWT25;
00690 EXTERNAL FORTRAN PROCEDURE PTX1;
00700 EXTERNAL FORTRAN PROCEDURE XOUT;
00710 EXTERNAL FORTRAN PROCEDURE XFIN;
00720 INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00730 INTEGER IX,IX2,IY,XREF,YREF,X2,Y2,HT,XSAVE,XCUT;
00740 INTEGER MIN,MAX,ERR;
00741
00742 XSET;
00750 MIN←0;
00760 MAX←100;
00770 XREF←400;
00780 YREF←800;
00790 HT←400; ⊂ Allowing 3 inches for 3000 hertz;
00791 VERTAX(MIN,MAX,XREF,YREF,HT);
00792
00793 MAX←3000;
00794 YREF←150;
00795 HT←600; ⊂ Allowing 3 inches for 3000 hertz;
00810 VERTAX(MIN,MAX,XREF,YREF,HT);
00820 XOUT(XREF-8);
00830 XSAVE←0;
00840
00850 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
00860 LOOKUP(CHAN5,FILEP,ERR);
00870 FILEINFO(SAVE);
00880 IF ERR THEN OUTSTR("FILE "&FILEP&" NOT FOUND"&CRLF);
00890 ARRYIN(CHAN5,LFILE[0],'200);
00900
00910 XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
00920 IX←XREF; IY←YREF-100; SWT25(IX,IY);
00930 READ←WTIM; SETFORMAT(1,0);
00940
00950 XSTR←"The first "&CVS(NUM)&" formants in parameter file "
00960 &FILEP&" (created "&READ&")";
00970 IX←XREF; IY←1450; SWT25(IX,IY);
00980 XSTR←"Mute level at "&CVS(MUTE)&". "&MEMO;
00990 IX←XREF+100; IY←1420; SWT25(IX,IY);
01000 XSTR←"A.I. Laboratory, Stanford University. "&DATIME;
01010 IX←XREF+200; IY←1390; SWT25(IX,IY);
01020
01030 FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01040 IF LFILE[I]=0 THEN DONE;
01050 L←LFILE[I] LAND '777760000000;
01060 J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01070
01080 X←J*128%SCALE+K*64%SCALE-8; ⊂ X←(J+K%2)*128%32-8;
01090 IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01100 IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01110 IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01120 IY←YREF-70; SWT25(IX,IY); END;
01130
01140 IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01150 XLINE(IX,YREF-20,IX,YREF);
01160 XLINE(IX,YREF,IX2,YREF);
01170 XLINE(IX,YREF-1,IX2,YREF-1);
01180 XLINE(IX,YREF-2,IX2,YREF-2);
01190 XLINE(IX2,YREF,IX2, YREF-20);
01200
01210 END "PONY";
01220 OUTSTR("Text,");
01225
01230 FOR I←0 STEP 20000%SCALE UNTIL IX DO BEGIN "TIME"
01240 XLINE(XREF+I,YREF,XREF+I,YREF+20);
01242 IF I≠0 THEN FOR J←100 STEP 100 UNTIL 600 DO BEGIN
01243 XLINE(XREF+I-5,YREF+J,XREF+I+5,YREF+J);
01246 XLINE(XREF+I,YREF+J-5,XREF+I,YREF+J+5); END;
01250 FOR K←1 STEP 1 UNTIL 9 DO BEGIN
01260 IX←XREF+I+K*2000%SCALE; IF IX>IX2 THEN DONE "TIME";
01270 XLINE(IX,YREF,IX,YREF+10);
01275 FOR J←100 STEP 100 UNTIL 600 DO BEGIN
01276 XLINE(IX-2,YREF+J,IX+2,YREF+J); XLINE(IX,YREF+J-2,IX,YREF+J+2); END;
01277 END;
01280 END "TIME";
01285 XOUT(XREF-1);
01290
01300 XCUT←IX2+200;
01310
01320
01330 FOR I←0 STEP 1 UNTIL 10 DO SAVE[I]←0;
01340 WHILE EOF=0 DO BEGIN "XDATIN"
01345 FOR I ←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01350 ARRYIN(CHAN5,NEW[0],512);
01355 IF NEW[0]=0 THEN DONE;
01360
01370 FOR I←1 STEP 1 UNTIL NUM DO BEGIN "XPLO"
01380 LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+LY);
01390 FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01400 IF NEW[J]=0 THEN DONE;
01410 X←(NEW[J] LSH -15)%SCALE;
01420 ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01430 ⊂ This corresponds to 512 samples (32*16) per character;
01440
01450 POINTP←POINT(9,NEW[J+1],-1);
01460 FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01470 Y← LDB(POINTP)*2000%256; ⊂ 5 inches for 5000 hertz;
01480
01490 IF Y=0 THEN Y←LY;
01500 DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01510 IF (LDB(POINT(9,NEW[J+2],17)) < MUTE)∨(DX<3)
01520 THEN XIRVEC(DX,DY) ELSE XRVEC(DX,DY);
01530 END;
01540 SAVE[I]←LY;
01550 END "XPLO";
01560
01570 FOR I←6 STEP 1 UNTIL NUM+5 DO BEGIN "XPLO2"
01580 LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+650+LY);
01590 FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01600 IF NEW[J]=0 THEN DONE;
01610 X←(NEW[J] LSH -15)%SCALE;
01620 ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01630 ⊂ This corresponds to 512 samples (32*16) per character;
01640
01650 POINTP←POINT(9,NEW[J+1],-1); ⊂****** FIX ;
01660 FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01670 Y← LDB(POINTP)*2000%256; ⊂ 5 inches for 5000 hertz;
01680
01690 IF Y=0 THEN Y←LY;
01700 DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01710 IF (LDB(POINT(9,NEW[J+2],17)) < MUTE)∨(DX<3)
01720 THEN XIRVEC(DX,DY) ELSE XRVEC(DX,DY);
01730 END;
01740 SAVE[I]←LY;
01750 END "XPLO2";
01760
02560 XOUT(LX-20); OUTSTR(CVS(LX)&",");
02570
02580 IF X=0 THEN DONE "XDATIN";
02590 SAVE[0]←LX;
02600 END "XDATIN";
02610 CLOSE(CHAN5);
02620 XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
02630 IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
02640
02650 XFIN;
02660 END "XPLOT";
02670
00010 CHAN1←1; CHAN5←5;
00015 SCALE←20;
00020 STDBRK(1);
00030 STARTP:
00040 MUTE←60; NUM←3;
00050 CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00060 LOOKUP(CHAN1,"NUMBER.TMP",ER);
00070 IF ER THEN BEGIN
00080 OUTSTR("The following set-up commands of a letter followed by a number "
00090 &"may be given:"&CRLF);
00100 OUTSTR(" M# sets MUTE level (default value 60)"&CRLF&
00110 " N# sets number of formants (default value 3)."&CRLF);
00120 OUTSTR("A number only uses preset values for M and N and specifies the file to use."
00130 &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00140 SETFORMAT(1,0); FLAG←0; X←0;
00150 WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command "); READ←INCHWL;
00160 IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00170 IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00180 DONE; END "TYPE";
00190 IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00200 END ELSE BEGIN
00210 PP←CVD(INPUT(CHAN1,1));
00215 MEMO←INPUT(CHAN1,1);
00220 CLOSE(CHAN1);
00230 END;
00240
00250 FILEP←"SEG"&CVS(PP)&".SYN[SYN,ALS]";
00260
00270 XPLOT;
00280 IF ER THEN PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF) ELSE
00290 PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF&"K"&CRLF);
00300
00310 END "XRUN";